home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / walpeep / wallpeep.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-08  |  12.8 KB  |  440 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BorderStyle     =   3  'Fixed Double
  4.    Caption         =   "WallPeeper"
  5.    ClientHeight    =   3960
  6.    ClientLeft      =   105
  7.    ClientTop       =   690
  8.    ClientWidth     =   4455
  9.    FillColor       =   &H00010000&
  10.    ForeColor       =   &H00808080&
  11.    Height          =   4650
  12.    Icon            =   WALLPEEP.FRX:0000
  13.    Left            =   45
  14.    LinkMode        =   1  'Source
  15.    LinkTopic       =   "Form1"
  16.    MaxButton       =   0   'False
  17.    ScaleHeight     =   264
  18.    ScaleMode       =   3  'Pixel
  19.    ScaleWidth      =   297
  20.    Top             =   60
  21.    Width           =   4575
  22.    Begin CheckBox ShowAllFiles 
  23.       Caption         =   "Show all usable files on C"
  24.       FontBold        =   0   'False
  25.       FontItalic      =   0   'False
  26.       FontName        =   "MS Sans Serif"
  27.       FontSize        =   8.25
  28.       FontStrikethru  =   0   'False
  29.       FontUnderline   =   0   'False
  30.       Height          =   255
  31.       Left            =   75
  32.       TabIndex        =   13
  33.       Top             =   2910
  34.       Width           =   2175
  35.    End
  36.    Begin CheckBox TileChecked 
  37.       Caption         =   "Tile"
  38.       FontBold        =   0   'False
  39.       FontItalic      =   0   'False
  40.       FontName        =   "MS Sans Serif"
  41.       FontSize        =   8.25
  42.       FontStrikethru  =   0   'False
  43.       FontUnderline   =   0   'False
  44.       Height          =   255
  45.       Left            =   75
  46.       TabIndex        =   12
  47.       Top             =   3630
  48.       Value           =   1  'Checked
  49.       Width           =   735
  50.    End
  51.    Begin PictureBox Picture2 
  52.       AutoRedraw      =   -1  'True
  53.       AutoSize        =   -1  'True
  54.       Height          =   450
  55.       Left            =   1440
  56.       ScaleHeight     =   28
  57.       ScaleMode       =   3  'Pixel
  58.       ScaleWidth      =   33
  59.       TabIndex        =   11
  60.       Top             =   4200
  61.       Width           =   525
  62.    End
  63.    Begin CheckBox ResizableChecked 
  64.       Caption         =   "Resizable"
  65.       FontBold        =   0   'False
  66.       FontItalic      =   0   'False
  67.       FontName        =   "MS Sans Serif"
  68.       FontSize        =   8.25
  69.       FontStrikethru  =   0   'False
  70.       FontUnderline   =   0   'False
  71.       Height          =   240
  72.       Left            =   2400
  73.       TabIndex        =   10
  74.       Top             =   4320
  75.       Value           =   1  'Checked
  76.       Width           =   1485
  77.    End
  78.    Begin Timer Timer1 
  79.       Left            =   930
  80.       Top             =   5925
  81.    End
  82.    Begin PictureBox Picture1 
  83.       AutoRedraw      =   -1  'True
  84.       AutoSize        =   -1  'True
  85.       BorderStyle     =   0  'None
  86.       Height          =   450
  87.       Left            =   240
  88.       ScaleHeight     =   30
  89.       ScaleMode       =   3  'Pixel
  90.       ScaleWidth      =   35
  91.       TabIndex        =   4
  92.       Top             =   4200
  93.       Width           =   525
  94.    End
  95.    Begin FileListBox File2 
  96.       Height          =   810
  97.       Left            =   2475
  98.       Pattern         =   "*.bmp;*.ico;*.wmf;*.rle;*.dib"
  99.       TabIndex        =   7
  100.       Top             =   4755
  101.       Width           =   1845
  102.    End
  103.    Begin DirListBox Dir2 
  104.       Height          =   900
  105.       Left            =   60
  106.       TabIndex        =   6
  107.       Top             =   4755
  108.       Width           =   2280
  109.    End
  110.    Begin CommandButton Command1 
  111.       Caption         =   "Set as Wallpaper"
  112.       Default         =   -1  'True
  113.       Height          =   315
  114.       Left            =   75
  115.       TabIndex        =   9
  116.       Top             =   3240
  117.       Width           =   4275
  118.    End
  119.    Begin CommandButton Command2 
  120.       Caption         =   "Refresh List"
  121.       Enabled         =   0   'False
  122.       Height          =   315
  123.       Left            =   2430
  124.       TabIndex        =   3
  125.       Top             =   2880
  126.       Visible         =   0   'False
  127.       Width           =   1920
  128.    End
  129.    Begin DirListBox Dir1 
  130.       ForeColor       =   &H00000000&
  131.       Height          =   2280
  132.       Left            =   75
  133.       TabIndex        =   0
  134.       Top             =   555
  135.       Width           =   2295
  136.    End
  137.    Begin ListBox List1 
  138.       Enabled         =   0   'False
  139.       Height          =   2760
  140.       Left            =   2445
  141.       Sorted          =   -1  'True
  142.       TabIndex        =   5
  143.       Top             =   75
  144.       Visible         =   0   'False
  145.       Width           =   1905
  146.    End
  147.    Begin FileListBox File1 
  148.       Height          =   2760
  149.       Left            =   2445
  150.       Pattern         =   "*.bmp;*.ico;*.wmf;*.rle;*.dib"
  151.       TabIndex        =   1
  152.       Top             =   75
  153.       Width           =   1905
  154.    End
  155.    Begin DriveListBox Drive1 
  156.       Height          =   315
  157.       Left            =   75
  158.       TabIndex        =   2
  159.       Top             =   75
  160.       Width           =   2295
  161.    End
  162.    Begin Label Label1 
  163.       Alignment       =   1  'Right Justify
  164.       Height          =   240
  165.       Left            =   2970
  166.       TabIndex        =   8
  167.       Top             =   2940
  168.       Visible         =   0   'False
  169.       Width           =   1335
  170.    End
  171.    Begin Menu FileMenu 
  172.       Caption         =   "File"
  173.       Begin Menu FileExit 
  174.          Caption         =   "E&xit"
  175.       End
  176.       Begin Menu FileSep 
  177.          Caption         =   "-"
  178.       End
  179.       Begin Menu FileAbout 
  180.          Caption         =   "&About WallPeeper..."
  181.       End
  182.    End
  183. DefInt A-Z
  184. Declare Function GetVersion Lib "Kernel" () As Long
  185. Declare Function GetWindowsDirectory Lib "kernel" (ByVal P$, ByVal S)
  186. Declare Sub SystemParametersInfo Lib "User" (ByVal wAction%, ByVal wParam%, lParam As Any, ByVal fWinIni%)
  187. Declare Function WriteProfileString% Lib "Kernel" (ByVal lpAppName$, ByVal lpKeyName$, ByVal lpString$)
  188. Const SPI_SETDESKWALLPAPER = 20
  189. Const SPIF_UPDATEINIFILE = 1     'update Win.ini Const
  190. Const SPIF_SENDWININICHANGE = 2  'update Win.ini and tell everyone
  191. Sub Command1_Click ()
  192. OldMouseP = Screen.MousePointer
  193. Screen.MousePointer = 11
  194. Dim WinPath As String
  195. BmpFile$ = "WALLPEEP.BMP"
  196. WinPath = String$(145, Chr$(0))
  197. T% = GetWindowsDirectory(WinPath, Len(WinPath))
  198. WinPath = Left$(WinPath, T%)
  199. Call DragPictureTo((Form2.DestinationPic.Width), (Form2.DestinationPic.Height), False)
  200. Form1.Picture2.Picture = Form2.DestinationPic.Image
  201. Call DottedLine
  202. Form1.Picture2.Width = Form2.DestinationPic.Width
  203. Form1.Picture2.Height = Form2.DestinationPic.Height
  204. Form1.Picture2.ScaleWidth = Form2.DestinationPic.ScaleWidth
  205. Form1.Picture2.ScaleHeight = Form2.DestinationPic.ScaleHeight
  206. SavePicture Form1.Picture2.Image, WinPath + "\" + BmpFile$
  207. '[Desktop]
  208. 'Pattern = (None)
  209. 'Wallpaper=C:\WINDOWS\WALLVIEW.BMP
  210. 'GridGranularity = 0
  211. 'IconSpacing = 93
  212. 'TileWallPaper = 1
  213. If Form1.TileChecked.Value = 0 Then
  214.    T% = WriteProfileString%("Desktop", "TileWallPaper", "0")
  215.    T% = WriteProfileString%("Desktop", "TileWallPaper", "1")
  216. End If
  217. SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal WinPath + "\" + BmpFile$, SPIF_UPDATEINIFILE
  218. Screen.MousePointer = OldMouseP
  219. End Sub
  220. Sub Command2_Click ()
  221. Command2.Enabled = False
  222. OldMousePointer = Screen.MousePointer
  223. Screen.MousePointer = 11
  224. Call FillList
  225. Screen.MousePointer = OldMousePointer
  226. End Sub
  227. Sub Dir1_Change ()
  228. File1.Path = Dir1.Path
  229. End Sub
  230. Sub Dir1_Click ()
  231. Dir1.Path = Dir1.List(Dir1.ListIndex)
  232. End Sub
  233. Sub Drive1_Change ()
  234. On Error Resume Next
  235. If SavedDrive$ = Drive1.Drive Then Exit Sub
  236. Dir1.Path = Drive1.Drive
  237. If Err <> 0 Then
  238.    On Error Resume Next
  239.    MsgBox "Error reading drive " + Drive1.Drive
  240.    Drive1.Drive = SavedDrive$
  241.    On Error Resume Next
  242.    Dir1.Path = Drive1.Drive
  243.    On Error GoTo 0
  244.    Exit Sub
  245. End If
  246. On Error GoTo 0
  247. If (List1.ListCount > 0) And (SavedDrive$ <> Drive1.Drive) Then
  248.    ClearListBox Form1.List1
  249. End If
  250. SavedDrive$ = Drive1.Drive
  251. T$ = ShowAllFiles.Caption
  252. Mid$(T$, Len(T$), 1) = UCase$(Drive1.Drive)
  253. ShowAllFiles.Caption = T$
  254. If ShowAllFiles.Value = False Then
  255.    OldMousePointer = Screen.MousePointer
  256.    Screen.MousePointer = 11
  257.    Call FillList
  258.    Screen.MousePointer = OldMousePointer
  259. End If
  260. End Sub
  261. Sub Drive1_GotFocus ()
  262. SavedDrive$ = Drive1.Drive
  263. End Sub
  264. Sub File1_Click ()
  265. Call ShowPicture((File1.Path), (File1.FileName))
  266. Call WallPaper
  267. Call PositionOutline
  268. If Not Loading Then
  269.    Call DottedLine
  270. End If
  271. End Sub
  272. Sub File1_DblClick ()
  273. Call File1DClick
  274. End Sub
  275. Sub FileAbout_Click ()
  276. Form3.Show 1
  277. End Sub
  278. Sub FileExit_Click ()
  279. End Sub
  280. Sub Form_Load ()
  281. Loading% = True
  282. OldMousePointer = Screen.MousePointer
  283. Screen.MousePointer = 11
  284. Ver& = GetVersion()
  285. WinVer& = Ver& Mod &H10000
  286. WinVersion$ = Format$(WinVer& Mod &H100) + "." + Format$(WinVer& \ &H100)
  287. If WinVersion$ < "3.1" Then
  288.    Screen.MousePointer = OldMousePointer
  289.    MsgBox "This program requires Windows 3.1."
  290.    End
  291. End If
  292. Load Form2
  293. Call GetBackgroundColor
  294. Form1.Visible = 1
  295. Form2.Visible = 1
  296. T% = DoEvents()
  297. If File1.ListCount > 0 Then File1.ListIndex = 0
  298. Form1.SetFocus
  299. ResizableChecked_Click
  300. Focus = -1
  301. Timer1.Interval = 10
  302. SavedDrive$ = Drive1.Drive
  303. Screen.MousePointer = OldMousePointer
  304. Loading% = False
  305. End Sub
  306. Sub Form_Resize ()
  307. 'Command1.Top = Scaleheight - Command1.height - 6
  308. 'Command1.Left = Scalewidth - Command1.width - 6
  309. If Form1.WindowState = 1 Then ' minimized
  310.       Form2.Visible = False
  311.       Form2.WindowState = 0
  312.    Else
  313.       Form2.Visible = True
  314. End If
  315. End Sub
  316. Sub Form_Unload (Cancel As Integer)
  317. End Sub
  318. Sub List1_Click ()
  319. Call GetNameAndDir((List1.List(List1.ListIndex)), FName$, DName$)
  320. Dir1.Path = DName$
  321. Call ShowPicture(DName$, FName$)
  322. Call WallPaper
  323. Call PositionOutline
  324. Call DottedLine
  325. End Sub
  326. Sub List1_DblClick ()
  327. Call List1DClick
  328. End Sub
  329. Sub ResizableChecked_Click ()
  330. 'Form2.Enabled = False
  331. If ResizableChecked.Value Then
  332.    Form2.DestinationPic.Width = Form2.DestinationPic.Width + 2
  333.    Form2.DestinationPic.Height = Form2.DestinationPic.Height + 2
  334.    Form2.DestinationPic.Top = Form2.DestinationPic.Top - 1
  335.    Form2.DestinationPic.Left = Form2.DestinationPic.Left - 1
  336.    Form2.DestinationPic.Width = Form2.DestinationPic.Width - 2
  337.    Form2.DestinationPic.Height = Form2.DestinationPic.Height - 2
  338.    Form2.DestinationPic.Top = Form2.DestinationPic.Top + 1
  339.    Form2.DestinationPic.Left = Form2.DestinationPic.Left + 1
  340. End If
  341. 'Form2.Enabled = True
  342. Call PositionOutline
  343. Call WallPaper
  344. Call DottedLine
  345. End Sub
  346. Sub SelectInFIleList (T$)
  347.    For I = 1 To File1.ListCount
  348.       If T$ = File1.List(I - 1) Then
  349.      File1.ListIndex = I - 1
  350.      Exit Sub
  351.       End If
  352.    Next I
  353. End Sub
  354. Sub ShowAllFiles_Click () 'Value As Integer
  355. OldMousePointer = Screen.MousePointer
  356. Screen.MousePointer = 11
  357. If ShowAllFiles.Value = 0 Then
  358.    T$ = ""
  359.    If List1.ListCount > 0 Then
  360.       T$ = List1.List(List1.ListIndex)
  361.       T$ = Left$(T$, InStr(T$, Chr$(9)) - 1)
  362.    End If
  363.    List1.Visible = False
  364.    List1.Enabled = False
  365.    File1.Visible = True
  366.    File1.Enabled = True
  367.    SelectInFIleList (T$)
  368.    Dir1.ForeColor = RGB(0, 0, 0)
  369.    Dir1.Enabled = True
  370.    Command2.Visible = False
  371.    T$ = ""
  372.    If File1.ListCount > 0 Then
  373.       T$ = File1.List(File1.ListIndex)
  374.    End If
  375.    For J = 1 To Dirs
  376.       If DirName(J) = Dir1.Path Then
  377.      T$ = T$ + Chr$(9) + Chr$(9) + Format$(J)
  378.      Exit For
  379.       End If
  380.    Next J
  381.    'For I = 1 To List1.ListCount
  382.    '   If T$ = List1.List(I - 1) Then
  383.    '      List1.ListIndex = I - 1
  384.    '      Exit For
  385.    '   End If
  386.    'Next I
  387.    TI% = FindItem(List1, T$)
  388.    If TI% <> -1 Then List1.ListIndex = TI%
  389.    File1.Visible = False
  390.    File1.Enabled = False
  391.    List1.Visible = True
  392.    List1.Enabled = True
  393.    Command2.Visible = True
  394.    If List1.ListCount = 0 Then
  395.       Call FillList
  396.       Command2.Enabled = False
  397.    End If
  398.    Dir1.ForeColor = RGB(128, 128, 128)
  399.    Dir1.Enabled = False
  400. End If
  401. Screen.MousePointer = OldMousePointer
  402. End Sub
  403. Sub TileChecked_Click () 'Value As Integer
  404. 'DoEvents
  405. Call DragPictureTo((Form2.DestinationPic.Width), (Form2.DestinationPic.Height), False)
  406. Call WallPaper
  407. Call PositionOutline
  408. Call DottedLine
  409. 'DoEvents
  410. End Sub
  411. Sub Timer1_Timer ()
  412.   T = GetActiveWindow()
  413.   If Focus Then
  414.     If T <> Form1.hWnd And T <> Form2.hWnd And T <> Form3.hWnd Then
  415.       Focus = 0
  416.     End If
  417.   Else
  418.     If T = Form1.hWnd Or T = Form2.hWnd Or T = Form3.hWnd Then
  419.       Call GetBackgroundColor
  420.       If ShowAllFiles.Value Then
  421.      Form1.Command2.Enabled = True
  422.      Call List1_Click
  423.       Else
  424.      If File1.ListIndex <> -1 Then
  425.         TT$ = File1.List(File1.ListIndex)
  426.      End If
  427.      File1.Refresh
  428.      If File1.ListCount > 0 Then
  429.         SelectInFIleList (TT$)
  430.         If File1.ListIndex < 0 Then
  431.            File1.ListIndex = 0
  432.            Call File1_Click
  433.         End If
  434.      End If
  435.       End If
  436.       Focus = -1
  437.     End If
  438.   End If
  439. End Sub
  440.